0402

library

library(tidymodels)

## ── Attaching packages ────────────────────────────────────── tidymodels 0.1.3 ──

## ✓ broom        0.7.6      ✓ recipes      0.1.16
## ✓ dials        0.0.9      ✓ rsample      0.1.0 
## ✓ dplyr        1.0.6      ✓ tibble       3.1.2 
## ✓ ggplot2      3.3.3      ✓ tidyr        1.1.3 
## ✓ infer        0.5.4      ✓ tune         0.1.5 
## ✓ modeldata    0.1.0      ✓ workflows    0.2.2 
## ✓ parsnip      0.1.5      ✓ workflowsets 0.0.2 
## ✓ purrr        0.3.4      ✓ yardstick    0.0.8

## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## x purrr::discard() masks scales::discard()
## x dplyr::filter()  masks stats::filter()
## x dplyr::lag()     masks stats::lag()
## x recipes::step()  masks stats::step()
## • Use tidymodels_prefer() to resolve common conflicts.

library(tidyverse)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──

## ✓ readr   1.4.0     ✓ forcats 0.5.1
## ✓ stringr 1.4.0

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x readr::col_factor() masks scales::col_factor()
## x purrr::discard()    masks scales::discard()
## x dplyr::filter()     masks stats::filter()
## x stringr::fixed()    masks recipes::fixed()
## x dplyr::lag()        masks stats::lag()
## x readr::spec()       masks yardstick::spec()

library(magrittr)

## 
## Attaching package: 'magrittr'

## The following object is masked from 'package:tidyr':
## 
##     extract

## The following object is masked from 'package:purrr':
## 
##     set_names

library(skimr)
library(knitr)

1교시 : β 줄이기(변수선택) ————————

입력 변수의 수를 줄였을때의 장점
- 잡음(noise)를 제거해 모형의 정확도를 개선함
- 모형의 연산 속도가 빨라짐
- 다중공선성의 문제를 제거해 모형의 해석 능력을 향상시킴
ex) 나이, 생년은 같은 의미를 갖기 때문에 하나를 제거함
- 계수축소법에는 Ridge와 LASSO, Elastic Net이 있음

1.1] Ridge(능선) regression

• L2 norm(제곱합) 으로 표현
  

• λ가 클수록 β값들이 0으로 수렴

• f(β;x,y) = (Y-Xβ)^T * (Y-Xβ) + λ*β^T * I * β
  (단, X = 1더해진 x메트릭스)

• hat β(Ridge) = (X^T * X + λ*I)^{-1} * X^T * Y

1.2] LASSO regression

• (Least Absolute Shrinkage and Selection Operator)
  

• L1 norm(절대값 합) 으로 표현
  

• λ가 클수록 β값들이 0이 됨

• f(β;x,y) = (Y-Xβ)^T * (Y-Xβ) + λ*│β│
  

• hat β(LASSO) 수식으로 구하기 어려움
  

공통점

• 계수축소법으로 잔차와 회귀계수를 최소화하는 최적화 문제임
  
• 즉 min SSE + f(β)의 목적함수를 푸는 문제임
  

차이점

• Ridge는 계수가 0에 가깝게 축소되는데 비해
  LASSO는 계수가 0으로 축소됨
• Rigde는 X가 전반적으로 비슷한 수준으로 영향을 미칠때 사용
  LASSO는 X마다 영향력 편차가 큰 경우에 사용

knitr::include_graphics("lec6-1.png")

1.3] Elastic Net

• L1 norm(절대값 합) L2 norm(제곱합) 둘 다 사용
  
• R에서는 λ와 α를 써서 변형된 모델로 사용
  
• f(β;x,y) = (Y-Xβ)^T * (Y-Xβ) + λ*│β│  + λ*β^T * β
  

knitr::include_graphics("lec6-2.png")

2~3교시 : β 줄이기(변수선택) 실습 ————————

2.1] Ridge regression 의 λ에 따른 beta값 변화 예시

X <- as.matrix(mtcars[,2:10])
X <- cbind(1, X)

Y <- mtcars[,1]

beta <- solve(t(X) %*% X) %*% t(X) %*% Y
beta 

##             [,1]
##      12.83083549
## cyl  -0.16881263
## disp  0.01623358
## hp   -0.02424055
## drat  0.70590083
## wt   -4.03214213
## qsec  0.86828517
## vs    0.36470431
## am    2.55092849
## gear  0.50293618

lambda <- 0

beta_r0 <- solve(t(X) %*% X + lambda*diag(ncol(X))) %*% t(X) %*% Y
beta_r0

##             [,1]
##      12.83083549
## cyl  -0.16881263
## disp  0.01623358
## hp   -0.02424055
## drat  0.70590083
## wt   -4.03214213
## qsec  0.86828517
## vs    0.36470431
## am    2.55092849
## gear  0.50293618

lambda <- 0.5
beta_r0.5 <- solve(t(X) %*% X + lambda*diag(ncol(X))) %*% t(X) %*% Y
lambda <- 1
beta_r1 <- solve(t(X) %*% X + lambda*diag(ncol(X))) %*% t(X) %*% Y
lambda <- 10
beta_r10 <- solve(t(X) %*% X + lambda*diag(ncol(X))) %*% t(X) %*% Y
lambda <- 100
beta_r100 <- solve(t(X) %*% X + lambda*diag(ncol(X))) %*% t(X) %*% Y
lambda <- 1000
beta_r1000 <- solve(t(X) %*% X + lambda*diag(ncol(X))) %*% t(X) %*% Y
lambda <- 10000
beta_r10000 <- solve(t(X) %*% X + lambda*diag(ncol(X))) %*% t(X) %*% Y

beta_set <- cbind(beta_r0, beta_r0.5, beta_r1, beta_r10, beta_r100, beta_r1000, beta_r10000)

beta_set

##             [,1]        [,2]        [,3]         [,4]         [,5]        [,6]
##      12.83083549  0.74307514  0.49494882  0.198919357  0.088735264  0.04927890
## cyl  -0.16881263  0.25706431  0.25718278  0.224612436  0.180121429  0.12821802
## disp  0.01623358  0.01468400  0.01234894 -0.007454818 -0.028568475 -0.02750663
## hp   -0.02424055 -0.02477501 -0.02506126 -0.019082526  0.004368847  0.03618592
## drat  0.70590083  1.24333430  1.31055615  1.178476809  0.486384025  0.21992398
## wt   -4.03214213 -3.88630631 -3.58389967 -1.510352725 -0.165549234  0.05068967
## qsec  0.86828517  1.19435739  1.16043661  1.051285639  1.194662009  0.94929368
## vs    0.36470431  0.18598527  0.14752118  0.009664062  0.046078466  0.05603508
## am    2.55092849  2.48686907  2.24417230  1.116382610  0.270646887  0.05872088
## gear  0.50293618  0.97997603  1.06959171  1.181758738  0.512698905  0.21702041
##              [,7]
##       0.013818160
## cyl   0.037845630
## disp -0.008200309
## hp    0.081506122
## drat  0.059373892
## wt    0.020379977
## qsec  0.277597557
## vs    0.016959345
## am    0.012531526
## gear  0.058070221

항등행렬 만들기 : diag(행개수, 열개수)

• 행, 열 하나만 써도 됨, ncol()를 이용하면 편함
• 위에서 X를 10개 열로 만들어 놔서 항등행렬이 아래와 같음

diag(ncol(X))

##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
##  [1,]    1    0    0    0    0    0    0    0    0     0
##  [2,]    0    1    0    0    0    0    0    0    0     0
##  [3,]    0    0    1    0    0    0    0    0    0     0
##  [4,]    0    0    0    1    0    0    0    0    0     0
##  [5,]    0    0    0    0    1    0    0    0    0     0
##  [6,]    0    0    0    0    0    1    0    0    0     0
##  [7,]    0    0    0    0    0    0    1    0    0     0
##  [8,]    0    0    0    0    0    0    0    1    0     0
##  [9,]    0    0    0    0    0    0    0    0    1     0
## [10,]    0    0    0    0    0    0    0    0    0     1

LASSO regression은 어려움. 절대값 처리하는 스킬 필요함.

2.2] train 세트를 나눠서 λ를 결정하기

• train 을 학습용과 validation set(나머지)으로 나누기
  
• 학습용에서 λ 후보들을 만들고, validation에서 λ 최종확정
  

knitr::include_graphics("lec6-3.png")

validation set 나누기 : validation_split()

validation_split <- validation_split(mtcars, prop = 0.7)
validation_split

## # Validation Set Split (0.7/0.3)  
## # A tibble: 1 x 2
##   splits          id        
##   <list>          <chr>     
## 1 <split [22/10]> validation

# 실제 내용을 보려면, 
validation_split$splits[[1]]$in_id

##  [1]  2 21  1 25  8  7 28 13 18 23 27 14 16 20 31 30  9 26 22 12 15  6

head(validation_split$splits[[1]]$in_id)

## [1]  2 21  1 25  8  7

tunning

- penalty = tune() : λ

- mixture = tune() : α (tune()자리에 0을 넣으면 ridge됨)

tune_spec <- linear_reg(penalty = tune(),
                        mixture = 0) %>%
  set_engine("glmnet")

# 0~1까지 람다를 균등하게 50개 뽑기
param_grid <- grid_regular(penalty(), levels = 50)
                           #mixture(),
                           #levels = list(penalty =100,
                                         #mixture = 10))
param_grid

## # A tibble: 50 x 1
##     penalty
##       <dbl>
##  1 1   e-10
##  2 1.60e-10
##  3 2.56e-10
##  4 4.09e-10
##  5 6.55e-10
##  6 1.05e- 9
##  7 1.68e- 9
##  8 2.68e- 9
##  9 4.29e- 9
## 10 6.87e- 9
## # … with 40 more rows

workflow() 만들기 : 학습하고 평가하는 모델

workflow <- workflow() %>% 
  add_model(tune_spec) %>%
  add_formula(mpg ~ .)

tunning 하기 : λ, α

library(tictoc)
doParallel::registerDoParallel()

tic()
tune_result <- workflow %>%
  tune_grid(validation_split, 
            grid = param_grid, 
            metrics = metric_set(rmse))
toc()

## 0.92 sec elapsed

tune_result %>%
  collect_metrics()

## # A tibble: 50 x 7
##     penalty .metric .estimator  mean     n std_err .config              
##       <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>                
##  1 1   e-10 rmse    standard    3.67     1      NA Preprocessor1_Model01
##  2 1.60e-10 rmse    standard    3.67     1      NA Preprocessor1_Model02
##  3 2.56e-10 rmse    standard    3.67     1      NA Preprocessor1_Model03
##  4 4.09e-10 rmse    standard    3.67     1      NA Preprocessor1_Model04
##  5 6.55e-10 rmse    standard    3.67     1      NA Preprocessor1_Model05
##  6 1.05e- 9 rmse    standard    3.67     1      NA Preprocessor1_Model06
##  7 1.68e- 9 rmse    standard    3.67     1      NA Preprocessor1_Model07
##  8 2.68e- 9 rmse    standard    3.67     1      NA Preprocessor1_Model08
##  9 4.29e- 9 rmse    standard    3.67     1      NA Preprocessor1_Model09
## 10 6.87e- 9 rmse    standard    3.67     1      NA Preprocessor1_Model10
## # … with 40 more rows

Visualization of the tunning result

tune_best <- tune_result %>% select_best(metric = "rmse")
tune_best$penalty

## [1] 1

# tune_best$mixture
tune_result %>% show_best()

## # A tibble: 5 x 7
##    penalty .metric .estimator  mean     n std_err .config              
##      <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>                
## 1 1   e+ 0 rmse    standard    3.44     1      NA Preprocessor1_Model50
## 2 6.25e- 1 rmse    standard    3.63     1      NA Preprocessor1_Model49
## 3 1   e-10 rmse    standard    3.67     1      NA Preprocessor1_Model01
## 4 1.60e-10 rmse    standard    3.67     1      NA Preprocessor1_Model02
## 5 2.56e-10 rmse    standard    3.67     1      NA Preprocessor1_Model03

plot

knitr::include_graphics("lec6-4.png")

knitr::include_graphics("lec6-5.png")

전체 데이터로 모델 적용시키고

knitr::include_graphics("lec6-6.png")

예측

knitr::include_graphics("lec6-7.png")

제출할 파일 생성

knitr::include_graphics("lec6-8.png")

validation이 우연히 잘못 뽑히면 망한다?

-> cross validation 으로 해결

knitr::include_graphics("lec6-9.png")

10개로 validation을 나누기 : vfold_cv()

• 10개, 가격이 골고루 담기도록 strata = 가격

knitr::include_graphics("lec6-10.png")

mixture를 살려서 돌리기 :

• tune_spec과 param_grid에서 mixture살리고, level을 맞춤
• 크면 오래걸리니까 패널티는 100개, mixtuer는 5개만
• 나머지 부분은 그대로(mixture=0만 패널티처럼 수정)

knitr::include_graphics("lec6-11.png")

점수를 올려보자 ————

3.1] outlier 제거 : filter()

knitr::include_graphics("lec6-12.png")

3.2] group mean값을 구해서 새로운 변수로 활용하자!

knitr::include_graphics("lec6-13.png")